home *** CD-ROM | disk | FTP | other *** search
/ Garbo / Garbo.cdr / mac / progrmng / cmlmcmpw.sit / Caml Light / examples / kb / prelude.ml < prev    next >
Encoding:
Text File  |  1991-05-23  |  2.4 KB  |  121 lines  |  [TEXT/MPS ]
  1.  
  2. (******* Quelques definitions du prelude CAML **************)
  3.  
  4. (* 0- les indispensables *)
  5.  
  6. exception failure of string;;
  7.  
  8. let failwith s = raise(failure s)
  9. ;;
  10.  
  11. (* 1- les paires *)
  12.  
  13. let fst (x,y) = x
  14. and snd (x,y) = y
  15. ;;
  16.  
  17. (* 2- Les listes *)
  18.  
  19. let prefix @ L1 L2 = append_rec L1
  20.   where rec append_rec = function
  21.       []  -> L2
  22.   |  a::L -> a :: append_rec L
  23. ;;
  24.  
  25. let do_list f = do_rec where rec do_rec = function
  26.      []  -> ()
  27.   | a::L -> f a; do_rec L
  28. ;;
  29.  
  30. let map f = map_rec where rec map_rec = function
  31.      []  -> []
  32.   | a::L -> f a :: map_rec L
  33. ;;
  34.  
  35. let it_list f = it_rec
  36.   where rec it_rec a = function
  37.        []  -> a
  38.     | b::L -> it_rec (f a b) L
  39. ;;
  40.  
  41. let it_list2 f = it_rec
  42.   where rec it_rec = fun
  43.      a    []       []    -> a
  44.    | a (a1::L1) (a2::L2) -> it_rec (f a (a1,a2)) L1 L2
  45.    | _    _        _     -> failwith "it_list2"
  46. ;;
  47.  
  48. let fold f = fold_rec where rec fold_rec a1 = function
  49.     [] -> (a1,[])
  50.   | b1::bl ->
  51.       let (a2,c2) = f a1 b1 in
  52.       let (a,cl) = fold_rec a2 bl in
  53.         (a, c2::cl)
  54. ;;
  55.  
  56. let exists p = exists_rec where rec exists_rec = function
  57.      []  -> false
  58.   | a::L -> (p a) or (exists_rec L)
  59. ;;
  60.  
  61. let for_all p = for_all_rec where rec for_all_rec = function
  62.      []  -> true
  63.   | a::L -> (p a) & (for_all_rec L)
  64. ;;
  65.  
  66. let rec rev_append =
  67.   fun  []    L  -> L
  68.    | (x::L1) L2 -> rev_append L1 (x::L2)
  69. ;;
  70.  
  71. let rev L = rev_append L []
  72. ;;
  73.  
  74. let rec length = function
  75.      []  -> 0
  76.   | a::L -> succ(length L)
  77. ;;
  78.  
  79. let try_find f = try_find_rec where rec try_find_rec = function
  80.      []  -> failwith "try_find"
  81.   | a::L -> try f a with failure _ -> try_find_rec L
  82. ;;
  83.  
  84. let partition p = part_rec where rec part_rec = function
  85.      []  -> [],[]
  86.   | a::L -> let (pos,neg) = part_rec L in
  87.               if p a then  a::pos, neg else pos, a::neg
  88. ;;
  89.  
  90. (* 3- Les ensembles et les listes d'association *)
  91.  
  92. let mem a = mem_rec where rec mem_rec = function
  93.      []  -> false
  94.   | b::L -> a=b or mem_rec L
  95. ;;
  96.  
  97. let union L1 L2 = union_rec L1
  98.   where rec union_rec = function
  99.       []  -> L2
  100.    | a::L -> if mem a L2 then union_rec L else a :: union_rec L
  101. ;;
  102.  
  103.  
  104. let mem_assoc a = mem_rec where rec mem_rec = function
  105.        []    -> false
  106.   | (b,_)::L -> a=b or mem_rec L
  107. ;;
  108.  
  109. let assoc a = assoc_rec where rec assoc_rec = function
  110.        []    -> failwith "find"
  111.   | (b,d)::L -> if a=b then d else assoc_rec L
  112. ;;
  113.  
  114. (* 4- Les sorties *)
  115.  
  116. let print_newline () = print_string "\n"; flush std_out
  117. ;;
  118.  
  119. let message s = print_string s; print_newline()
  120. ;;
  121.